home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / builtin.scm < prev    next >
Encoding:
Text File  |  1991-06-21  |  13.1 KB  |  304 lines
  1. ; File builtin.scm / -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
  2. ; Copyright (c) 1991 Jonathan Rees / See file COPYING
  3.  
  4. ;;;; Compilation of calls to built-in Scheme procedures
  5.  
  6. ; The usual integrations
  7.  
  8. ; An entry in the integrations table is a pair, one of the following:
  9. ;   (FUN foo)            - translate as #'foo or (foo ...)
  10. ;   (PRED foo)         - translate calls as (schi:true? (foo ...))
  11. ;   (SUBST bvl body)     - translate calls as appropriate
  12. ;   (LAMBDA bvl body)    - ditto
  13. ;   (CASE-AUX)             - a special case kludge
  14.  
  15. ; The integrations table is indexed by Common Lisp symbols.
  16.  
  17. (define integrations-table (make-table))
  18.  
  19. (define (define-integration! var int)
  20.   (table-set! integrations-table var int))
  21.  
  22. (for-each (lambda (z)
  23.         (define-integration!
  24.           (program-env-lookup revised^4-scheme-env (car z))
  25.           (cadr z)))
  26.     `(
  27.       (*                              (fun lisp:*))
  28.       (+                              (fun lisp:+))
  29.       (-                              (fun lisp:-))
  30.       (/                              (fun lisp:/))
  31.       (<=                             (pred lisp:<=))
  32.       (<                              (pred lisp:<))
  33.       (=                              (pred lisp:=))
  34.       (>=                             (pred lisp:>=))
  35.       (>                              (pred lisp:>))
  36.       (abs                            (fun lisp:abs))
  37.       (acos                           (fun lisp:acos))
  38.       (angle                          (fun lisp:phase))
  39.       (append                         (fun lisp:append))
  40.       (apply                          (fun lisp:apply))
  41.       (asin                           (fun lisp:asin))
  42.       (assoc
  43.        (subst (obj list)
  44.      (schi:true? (lisp:assoc obj list
  45.                  :test (lisp:function schi:scheme-equal-p)))))
  46.       (assq
  47.        (subst (obj list)
  48.      (schi:true? (lisp:assoc obj list :test (lisp:function lisp:eq)))))
  49.       (assv                           (pred lisp:assoc 2))
  50.       (atan                           (fun lisp:atan))
  51.       (boolean?                  (pred schi:booleanp 1))
  52.       (caaaar                         (fun lisp:caaaar))
  53.       (caaadr                         (fun lisp:caaadr))
  54.       (caaar                          (fun lisp:caaar))
  55.       (caadar                         (fun lisp:caadar))
  56.       (caaddr                         (fun lisp:caaddr))
  57.       (caadr                          (fun lisp:caadr))
  58.       (caar                           (fun lisp:caar))
  59.       (cadaar                         (fun lisp:cadaar))
  60.       (cadadr                         (fun lisp:cadadr))
  61.       (cadar                          (fun lisp:cadar))
  62.       (caddar                         (fun lisp:caddar))
  63.       (cadddr                         (fun lisp:cadddr))
  64.       (caddr                          (fun lisp:caddr))
  65.       (cadr                           (fun lisp:cadr))
  66.       (call-with-current-continuation
  67.       (subst (proc)
  68.         (lisp:block continuation
  69.           (lisp:funcall proc
  70.           (lisp:function (lisp:lambda (val)
  71.                    (lisp:return-from continuation val)))))))
  72.       (call-with-input-file
  73.       (lambda (string proc)
  74.         (lisp:with-open-file (port (lisp:merge-pathnames string)
  75.                        :direction :input)
  76.           (lisp:funcall proc port))))
  77.       (call-with-output-file
  78.       (lambda (string proc)
  79.         (lisp:with-open-file (port (lisp:merge-pathnames string)
  80.                        :direction :output
  81.                        :if-exists :new-version)
  82.           (lisp:funcall proc port))))
  83.       (car                            (fun lisp:car))
  84.       (cdaaar                         (fun lisp:cdaaar))
  85.       (cdaadr                         (fun lisp:cdaadr))
  86.       (cdaar                          (fun lisp:cdaar))
  87.       (cdadar                         (fun lisp:cdadar))
  88.       (cdaddr                         (fun lisp:cdaddr))
  89.       (cdadr                          (fun lisp:cdadr))
  90.       (cdar                           (fun lisp:cdar))
  91.       (cddaar                         (fun lisp:cddaar))
  92.       (cddadr                         (fun lisp:cddadr))
  93.       (cddar                          (fun lisp:cddar))
  94.       (cdddar                         (fun lisp:cdddar))
  95.       (cddddr                         (fun lisp:cddddr))
  96.       (cdddr                          (fun lisp:cdddr))
  97.       (cddr                           (fun lisp:cddr))
  98.       (cdr                            (fun lisp:cdr))
  99.       (ceiling                        (fun lisp:ceiling))
  100.       (char->integer                  (fun lisp:char-code))
  101.       (char-alphabetic?               (pred lisp:alpha-char-p 1))
  102.       (char-ci<=?                     (pred lisp:char-not-greaterp))
  103.       (char-ci<?                      (pred lisp:char-lessp))
  104.       (char-ci=?                      (pred lisp:char-equal))
  105.       (char-ci>=?                     (pred lisp:char-not-lessp))
  106.       (char-ci>?                      (pred lisp:char-greaterp))
  107.       (char-downcase                  (fun lisp:char-downcase))
  108.       (char-lower-case?               (pred lisp:lower-case-p 1))
  109.       (char-numeric?                  (pred lisp:digit-char-p 1))
  110.       (char-ready?              (pred lisp:listen))
  111.       (char-upcase                    (fun lisp:char-upcase))
  112.       (char-upper-case?               (pred lisp:upper-case-p 1))
  113.       (char-whitespace?              (pred schi:char-whitespace-p 1))
  114.       (char<=?                        (pred lisp:char<=))
  115.       (char<?                         (pred lisp:char<))
  116.       (char=?                         (pred lisp:char=))
  117.       (char>=?                        (pred lisp:char>=))
  118.       (char>?                         (pred lisp:char>))
  119.       (char?                          (pred lisp:characterp 1))
  120.       (close-input-port               (fun lisp:close))
  121.       (close-output-port              (fun lisp:close))
  122.       (complex?                       (pred lisp:numberp 1))
  123.       (cons                           (fun lisp:cons))
  124.       (cos                            (fun lisp:cos))
  125.       (current-input-port
  126.        (subst () lisp:*standard-input*))
  127.       (current-output-port
  128.        (subst () lisp:*standard-output*))
  129.       (denominator                    (fun lisp:denominator))
  130.       (eof-object?
  131.        (subst (obj)
  132.      (schi:true? (lisp:eq obj schi:eof-object))))
  133.       (eq?                            (pred lisp:eq 2))
  134.       (equal?                  (pred schi:scheme-equal-p 2))
  135.       (eqv?                           (pred lisp:eql 2))
  136.       (even?                          (pred lisp:evenp 1))
  137.       (exact?                         (pred lisp:rationalp 1))
  138.       (exact->inexact                 (fun lisp:float))
  139.       (expt                           (fun lisp:expt))
  140.       (exp                            (fun lisp:exp))
  141.       (floor                          (fun lisp:floor))
  142.       (for-each                       (fun lisp:mapc))
  143.       (gcd                            (fun lisp:gcd))
  144.       (imag-part                      (fun lisp:imagpart))
  145.       (inexact?                       (pred lisp:floatp 1))
  146.       (inexact->exact                 (fun lisp:rationalize))
  147.       (input-port?              (pred schi:input-port-p 1))
  148.       (integer->char                  (fun lisp:code-char))
  149.       (integer?                       (pred lisp:integerp 1))
  150.       (lcm                            (fun lisp:lcm))
  151.       (length                         (fun lisp:length))
  152.       (list                           (fun lisp:list))
  153.       (list->string
  154.        (subst (l) (lisp:coerce (lisp:the lisp:list l)
  155.                    (lisp:quote lisp:simple-string))))
  156.       (list->vector
  157.        (subst (l) (lisp:coerce (lisp:the lisp:list l)
  158.                    (lisp:quote lisp:simple-vector))))
  159.       (list-ref
  160.        (subst (list n) (lisp:nth n list)))
  161.       (list-tail
  162.        (subst (list n) (lisp:nthcdr n list)))
  163.       (log                            (fun lisp:log))
  164.       (magnitude                      (fun lisp:abs))
  165.       (make-polar
  166.        (subst (r th) (lisp:* r (lisp:cis th))))
  167.       (make-rectangular               (fun lisp:complex))
  168.       (map                            (fun lisp:mapcar))
  169.       (max                            (fun lisp:max))
  170.       (member
  171.        (subst (obj list)
  172.      (schi:true? (lisp:member obj list
  173.                   :test (lisp:function schi:scheme-equal-p)))))
  174.       (memq
  175.        (subst (obj list)
  176.      (schi:true? (lisp:member obj list :test (lisp:function lisp:eq)))))
  177.       (memv                           (pred lisp:member 2))
  178.       (min                            (fun lisp:min))
  179.       (modulo                         (fun lisp:mod))
  180.       (negative?                      (pred lisp:minusp 1))
  181.       (newline                        (fun lisp:terpri))
  182.       (not                  (special))
  183.       (null?                          (pred lisp:null 1))
  184.       (number?                        (pred lisp:numberp 1))
  185.       (numerator                      (fun lisp:numerator))
  186.       (odd?                           (pred lisp:oddp 1))
  187.       (open-input-file
  188.        (subst (string)
  189.      (lisp:open (lisp:merge-pathnames string) :direction :input)))
  190.       (open-output-file
  191.        (subst (string)
  192.      (lisp:open (lisp:merge-pathnames string) :direction :output)))
  193.       (output-port?                   (pred schi:output-port-p 1))
  194.       ;; This isn't quite right; PAIR? wants to return false for
  195.       ;; procedures.  (Some Common Lisps implement some functions as
  196.       ;; pairs.)  But the runtime overhead of this check would be
  197.       ;; prohibitively high.
  198.       (pair?                          (pred lisp:consp 1))
  199.       (positive?                      (pred lisp:plusp 1))
  200.       (procedure?              (pred schi:procedurep 1))
  201.       (quotient
  202.        (subst (n1 n2)
  203.      (lisp:values (lisp:truncate n1 n2))))
  204.       (rational?                      (pred lisp:rationalp 1))
  205.       (real?                  (pred schi:realp 1))
  206.       (real-part                      (fun lisp:realpart))
  207.       (remainder                      (fun lisp:rem))
  208.       (reverse                        (fun lisp:reverse))
  209.       (round                          (fun lisp:round))
  210.       (set-car!
  211.        (subst (pair obj)
  212.      (lisp:setf (lisp:car pair) obj)
  213.      schi:unspecified))
  214.       (set-cdr!
  215.        (subst (pair obj)
  216.      (lisp:setf (lisp:cdr pair) obj)
  217.      schi:unspecified))
  218.       (sin                            (fun lisp:sin))
  219.       (sqrt                           (fun lisp:sqrt))
  220.       (string->list
  221.        (subst (string)
  222.      (lisp:coerce (lisp:the lisp:simple-string string)
  223.               (lisp:quote lisp:list))))
  224.       (string->symbol
  225.        (subst (string)
  226.      (lisp:values (lisp:intern string schi:scheme-package))))
  227.       (string-ci<=?                   (pred lisp:string-not-greaterp 2))
  228.       (string-ci<?                    (pred lisp:string-lessp 2))
  229.       (string-ci=?                    (pred lisp:string-equal 2))
  230.       (string-ci>=?                   (pred lisp:string-not-lessp 2))
  231.       (string-ci>?                    (pred lisp:string-greaterp 2))
  232.       (string-copy                    (fun lisp:copy-seq))
  233.       (string-fill!
  234.        (subst (s val)
  235.      (lisp:fill (lisp:the lisp:simple-string s) val)))
  236.       (string-length
  237.        (subst (s)
  238.          (lisp:length (lisp:the lisp:simple-string s))))
  239.       (string-ref
  240.        (subst (s k)
  241.      (lisp:char (lisp:the lisp:simple-string s) k)))
  242.       (string-set!
  243.        (subst (s k obj)
  244.      (lisp:setf (lisp:char (lisp:the lisp:simple-string s) k) obj)
  245.      schi:unspecified))
  246.       (string<=?                      (pred lisp:string<= 2))
  247.       (string<?                       (pred lisp:string< 2))
  248.       (string=?                       (pred lisp:string= 2))
  249.       (string>=?                      (pred lisp:string>= 2))
  250.       (string>?                       (pred lisp:string> 2))
  251.       (string?                        (pred lisp:simple-string-p 1))
  252.       (substring                      (fun lisp:subseq))
  253.       (symbol?                  (pred schi:scheme-symbol-p 1))
  254.       (tan                            (fun lisp:tan))
  255.       (transcript-off
  256.        (subst ()
  257.          (lisp:dribble)
  258.      schi:unspecified))
  259.       (transcript-on
  260.        (subst (filespec)
  261.          (lisp:dribble filespec)
  262.      schi:unspecified))
  263.       (truncate                       (fun lisp:truncate))
  264.       (vector                         (fun lisp:vector))
  265.       (vector->list
  266.        (subst (vec)
  267.      (lisp:coerce (lisp:the lisp:simple-vector vec)
  268.               (lisp:quote lisp:list))))
  269.       (vector-fill!
  270.        (subst (vec val)
  271.      (lisp:fill (lisp:the lisp:simple-vector vec) val)))
  272.       (vector-length
  273.        (subst (vec)
  274.          (lisp:length (lisp:the lisp:simple-vector vec))))
  275.       (vector-ref                     (fun lisp:svref))
  276.       (vector-set!
  277.        (subst (vec k obj)
  278.      (lisp:setf (lisp:svref vec k) obj)
  279.      schi:unspecified))
  280.       (with-input-from-file
  281.        (subst (string thunk)
  282.            (lisp:with-open-file (lisp:*standard-input*
  283.                      (lisp:merge-pathnames string)
  284.                  :direction :input)
  285.        (lisp:funcall thunk))))
  286.       (with-output-to-file
  287.        (subst (string thunk)
  288.      (lisp:with-open-file (lisp:*standard-output*
  289.                      (lisp:merge-pathnames string)
  290.                  :direction :output
  291.                  :if-exists :new-version)
  292.         (lisp:funcall thunk))))
  293.       (write-char                     (fun lisp:write-char))
  294.       (zero?                          (pred lisp:zerop 1))
  295.  
  296.       ;; Auxiliaries
  297.       (unassigned (subst () schi:unassigned))
  298.       (unspecified (val schi:unspecified))
  299.       (and-aux (special))
  300.       (or-aux (special))
  301.       (=>-aux (special))
  302.       (case-aux (special))
  303.       ))
  304.